home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / qbdoors.arc / QBDOORS.BAS < prev    next >
BASIC Source File  |  1987-11-23  |  4KB  |  143 lines
  1.      ' QuickBASIC example of a RBBS 'DOOR'
  2.      '   by Leo D. Farmer    Nov. 23, 1987
  3.      '
  4.      '
  5.      ' Set Error Trap & Establish Communications Variables
  6.      '
  7.      ON ERROR GOTO 10000
  8.      OPEN "R",1,"C:MESSAGES"
  9.      FIELD 1,128 AS R$
  10.      GET 1,2
  11.      BPS = VAL(MID$(R$,44,2))
  12.      PAR = VAL(MID$(R$,42,2))
  13.      RN$ = LEFT$(R$,30)
  14.      FOR I = LEN(RN$) TO 1 STEP -1
  15.          IF MID$(RN$,I,1) < > " " THEN _
  16.              EXIT FOR
  17.      NEXT I
  18.      RN$ = LEFT$(RN$,I)
  19.      IF PAR = -1 THEN _
  20.              P$ = "N,8,1,CS,DS,CD" _
  21.          ELSE P$ = "E,7,1,CD,DS,CD"
  22.      IF BPS = -3 THEN _
  23.              B$ = "1200," _
  24.          ELSE B$ = "300,"
  25.      CLOSE #1
  26.      MCR = &H3FC
  27.      MSR = &H3FE
  28.      CR$ = CHR$(13)
  29.      LF$ = CHR$(10)
  30.      OPEN "COM1:" + B$ + P$ AS #3
  31.      KEY OFF
  32.      CLS
  33.      '
  34.      ' Main Program Execution Section
  35.      '
  36.      LF = 1
  37.      RANDOMIZE TIMER
  38. 1040 NUMBER = INT(RND(1) * 100) + 1
  39. 1050 A$ = ""
  40.      GOSUB 2010
  41.      A$ = "I have a number between 1 and 100.  Type <Q> at any time to quit."
  42.      GOSUB 2010
  43.      TRY = 1
  44. 1070 A$ = "Guess #" + STR$(TRY) + "?"
  45.      GOSUB 4010
  46.      IF LEFT$(B$,1) = "Q" OR _
  47.          LEFT$(B$,1) = "q" THEN _
  48.          GOTO 5010
  49.      GUESS = VAL(B$)
  50.      IF GUESS < 1 OR _
  51.          GUESS > 100 OR _
  52.          GUESS < > INT(GUESS) THEN _
  53.              A$ = "Invalid guess." : _
  54.          GOSUB 2010 : _
  55.          GOTO 1070
  56.      IF GUESS = NUMBER THEN _
  57.           A$ = "Yes, that's right!!!" : _
  58.           GOSUB 2010 : _
  59.           A$ = "Here we go again . . . " : _
  60.           GOSUB 2010 : _
  61.           GOTO 1040
  62.      IF GUESS < NUMBER THEN _
  63.          A$ = "Too low." : _
  64.          GOSUB 2010 : _
  65.          GOTO 1130
  66.      A$ = "Too high."
  67.      GOSUB 2010
  68. 1130 TRY = TRY + 1
  69.      GOTO 1070
  70.      '
  71.      ' Print string with carriage return
  72.      '
  73. 2010 PRINT A$
  74.      PRINT #3,A$
  75.      PRINT #3,LF$
  76.      RETURN
  77.      '
  78.      ' Print string without carriage return
  79.      '
  80. 3010 PRINT A$;
  81.      PRINT #3,A$;
  82.      RETURN
  83.      '
  84.      ' Get User Input as B$ (A$ is printed as the question)
  85.      '
  86. 4010 B$ = ""
  87.      GOSUB 3010
  88. 4020 WHILE EOF(3) : _
  89.      Y$ = INKEY$ : _
  90.      IF Y$ < > "" THEN _
  91.          GOTO 4050
  92. 4030 WEND
  93. 4040 Y$ = ""
  94.      GOSUB 4170
  95.      Y$ = ""
  96.      Y$ = INPUT$(1,3)
  97.      IF Y$ = CHR$(127) THEN _
  98.          GOTO 4140
  99. 4050 IF Y$ = CHR$(8) OR _
  100.          Y$ = CHR$(7) OR _
  101.          Y$ = CHR$(26) OR _
  102.          Y$ = CHR$(27) THEN _
  103.          GOTO 4140
  104. 4060 IF Y$ < " " AND _
  105.          Y$ < > CR$ THEN _
  106.          GOTO 4020
  107. 4070 PRINT Y$;
  108.      PRINT #3,Y$;
  109.      IF Y$ = CR$ THEN _
  110.          GOTO 4120
  111.      IF LEN(B$) = > 254 THEN _
  112.          A$="Input too long -- Try again" : _
  113.          GOSUB 2010 : _
  114.          GOTO 4010
  115. 4110 B$ = B$ + Y$ : _
  116.          GOTO 4020
  117. 4120 PRINT #3,LF$
  118.      RETURN
  119. 4140 IF LEN(B$) = 0 THEN _
  120.          GOTO 4020
  121. 4150 B$ = LEFT$(B$,LEN(B$) - 1) : _
  122.          PRINT CHR$(29); CHR$(32); CHR$(29);
  123. 4160 PRINT #3,CHR$(8); CHR$(32); CHR$(8); : _
  124.          GOTO 4020
  125. 4170 IF INP(MSR) < 128 THEN _
  126.          GOTO 5020
  127.      RETURN
  128.      '
  129.      ' Return to DOS
  130.      '
  131. 5010 A$="Now returning to RBBS ..." : _
  132.          GOSUB 2010
  133. 5020 CLOSE 3 : _
  134.          OUT MCR,INP(MCR) OR 1 : _
  135.          SYSTEM
  136.       '
  137.       ' Error Trap
  138.       '
  139. 10000 IF ERR=57 AND ERL=4040 THEN 5020
  140.       A$ = "Error #" + STR$(ERR) + "in line" + STR$(ERL) + ".  Please tell SYSOP." : _
  141.           GOSUB 2010 : _
  142.           GOTO 5010
  143.